home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).adf / Analysis / analysis.bas (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-04-21  |  7KB  |  331 lines
  1. REM Hilfsmittel zur Analysis
  2. REM ------------------------
  3. REM 
  4. REM benutzte Variablen :
  5. REM
  6. REM   xu, xo     : Intervallgrenzen
  7. REM   ymin, ymax : groesster und kleinster Funktionswert im angegebenen Intervall
  8. REM   sx, dy, dx : Schrittweite mit der gearbeitet wird
  9. REM   a$, a      : Hilfsvariablen
  10. REM   ein$       : Ausgabe aus EINGABE-Routine
  11. REM
  12. REM  
  13.  
  14.   CLEAR,50000,10000
  15.   DEFDBL a-z
  16.   DIM fkt(700,1),fktzl%(700)
  17.   ON ERROR GOTO Fehler
  18.  
  19.   DEF FNf(x)=(x*x)/x
  20.   
  21.   
  22.  
  23. REM Unterprogramme
  24. REM --------------
  25.  
  26. SUB eingabe(ein$) STATIC
  27.     ein$=""
  28.   l1:
  29.     a$=INPUT$(1)
  30.     a=ASC(a$)
  31.     IF (a<48 OR a>57) AND (a<>13) AND (a<>8) AND (a<>43) AND (a<>45) AND (a<>46) THEN GOTO l1
  32.     IF a=8 AND LEN(ein$)>0 THEN ein$=LEFT$(ein$,LEN(ein$)-1):PRINT a$;
  33.     IF LEN(ein$)>=6 THEN GOTO l2
  34.     IF (a>=48 AND a<=57) OR a=43 OR a=45 OR a=46 THEN ein$=ein$+a$:PRINT a$;
  35.   l2:
  36.     IF a<>13 THEN GOTO l1
  37.     END SUB
  38.  
  39. SUB ExakteNullstelle(x,sx,i) STATIC
  40.     xl=x
  41.     xr=x+sx
  42.     xm=(xl+xr)/2
  43.   l3:
  44.     IF FNf(xl)*FNf(xm)<=0 THEN xr=xm :ELSE xl=xm
  45.     xm=(xl+xr)/2
  46.     IF xr-xl>1e-05 THEN GOTO l3:      
  47.     LOCATE i,10:PRINT "x = ";USING "#######.####";xm
  48.     LOCATE i,30:PRINT ", f(x) = 0"    
  49.     i=i+1
  50.     END SUB
  51.  
  52. SUB InitScreen2 STATIC
  53.     SCREEN 2,640,256,3,2
  54.     WINDOW 2,"",(0,0)-(631,242),0,2
  55.     CLS
  56.     PALETTE 0,0,0,0
  57.     PALETTE 1,0,0,0
  58.     PALETTE 2,1,1,0.8
  59.     PALETTE 3,1,1,0.7
  60.     PALETTE 4,1,1,0.5
  61.     PALETTE 5,0,1,0
  62.     PALETTE 6,1,0,0
  63.     PALETTE 7,0.3,0.3,0.3
  64.     END SUB
  65.  
  66.     
  67.   CALL InitScreen2
  68. hauptmenu:
  69.   REM Hauptmenue
  70.   REM ----------
  71.   COLOR 2
  72.   LOCATE 8,22:PRINT "Intervallgrenzen eingeben........1"
  73.   COLOR 3
  74.   LOCATE 10,22:PRINT "Wertetabelle ausgeben............2"
  75.   COLOR 2
  76.   LOCATE 12,22:PRINT "Funktionsanalyse.................3"
  77.   COLOR 3
  78.   LOCATE 14,22:PRINT "Graphen zeichen..................4"
  79.   COLOR 2
  80.   LOCATE 16,22:PRINT "Programm beenden.................0"
  81.   COLOR 4
  82.   LOCATE 19,22:PRINT "Ihre Eingabe             : (0-4) ";
  83.   COLOR 2
  84.   
  85. lbl1:
  86.   a$=INPUT$(1)
  87.   IF ASC(a$)<48 OR ASC(a$)>52 THEN GOTO lbl1
  88.   a=VAL(a$)
  89.   
  90.   IF a=0 THEN SCREEN CLOSE 2:ON ERROR GOTO 0:END
  91.   ON a GOSUB intervallgrenzen,wertetabelle,analyse,graph
  92.   WINDOW OUTPUT 2
  93.   GOTO hauptmenu
  94.         
  95.  
  96.  
  97. intervallgrenzen:
  98.     interflag=1
  99.     WINDOW 3,"",(0,0)-(631,242),0,2
  100.     COLOR 2
  101.     LOCATE 8,20:PRINT "Bitte geben Sie die Intervallgrenzen an,"
  102.     LOCATE 10,20:PRINT "in denen die Funktion untersucht werden"
  103.     LOCATE 12,20:PRINT "soll."
  104.   
  105.   lbl2:
  106.     COLOR 4
  107.     LOCATE 15,20:PRINT "untere Intervallgrenze :            ";
  108.     LOCATE 15,45:
  109.     COLOR 2
  110.     CALL eingabe(ein$)
  111.     xu=VAL(ein$)
  112.     COLOR 4
  113.     LOCATE 16,20:PRINT "obere Intervallgrenze  :            ";
  114.     LOCATE 16,45
  115.     COLOR 2
  116.     CALL eingabe(ein$)
  117.     xo=VAL(ein$)
  118.     IF xo<xu THEN SWAP xu,xo
  119.     IF xo=xu THEN GOTO lbl2 
  120.   
  121.     WINDOW CLOSE 3
  122.     SCREEN CLOSE 2
  123.     COLOR 2
  124.     LOCATE 2,6:PRINT "Einen Moment bitte.";
  125.     dx2=(ABS(xu)+ABS(xo))/631
  126.     ymin=FNf(xu):xr=xu
  127.     ymax=FNf(xu):xl=xu
  128.     i=0
  129.     FOR x =xu TO xo+dx2 STEP dx2
  130.       y=FNf(x)
  131.       IF errorflag=1 THEN 
  132.           errorflag=0
  133.           fktzl%(i)=1
  134.         ELSE 
  135.           IF y>ymax THEN ymax=y:xl=x 
  136.           IF y<ymin THEN ymin=y:xr=x
  137.           fktzl%(i)=0
  138.       END IF
  139.       fkt(i,0)=x
  140.       fkt(i,1)=y
  141.       i=i+1
  142.     NEXT x
  143.     dy=242/(ABS(ymin)+ABS(ymax))
  144.     dx=631/(ABS(xu)+ABS(xo))      
  145.     dy2=(ABS(ymin)+ABS(ymax))/242
  146.     xv=ABS(xu*dx)
  147.     yv=ABS(ymin*dy)
  148.     CALL InitScreen2
  149.     RETURN
  150.     
  151. wertetabelle:
  152.     IF interflag=0 THEN RETURN
  153.     WINDOW 3,"",(0,0)-(631,242),0,2
  154.     COLOR 4
  155.     LOCATE 2,24:PRINT "x"
  156.     LOCATE 2,41:PRINT "f(x)"
  157.    
  158.     i=0
  159.     j=0
  160.     FOR x=xu TO xo+dx2 STEP dx2*10
  161.       i=i+1
  162.       COLOR (i AND 1)+2
  163.       LOCATE 4+i,20:PRINT STRING$(50," ")
  164.       LOCATE 4+i,17:PRINT USING "#######.######";fkt(j,0) 
  165.       LOCATE 4+i,35 
  166.       IF fktzl%(j)=0 THEN PRINT USING "#######.######";fkt(j,1) ::ELSE PRINT "      ---        " 
  167.       IF i>=15 THEN WHILE INKEY$="": WEND:i=0
  168.       j=j+10
  169.     NEXT x
  170.     FOR x=i+1 TO 15
  171.       LOCATE 4+x,20:PRINT STRING$(50," ")
  172.     NEXT x
  173.   
  174.     WHILE INKEY$="": WEND
  175.     WINDOW CLOSE 3
  176.     RETURN
  177.  
  178. analyse:
  179.     IF interflag=0 THEN RETURN
  180.     
  181.     WINDOW 3,"",(0,0)-(631,242),0,2
  182.     COLOR 5
  183.     LOCATE 5,10:PRINT "Nullstellen"
  184.     COLOR 2
  185.   
  186.     j=0
  187.     i=7
  188.     FOR x=xu TO xo-dx2 STEP dx2
  189.       IF fktzl%(j)=1 OR fktzl%(j+1)=1 THEN GOTO lbl8
  190.       y=fkt(j,1)*fkt(j+1,1)
  191.       IF y<=0 THEN CALL ExakteNullstelle(x,dx2,i)
  192.   lbl8:
  193.       j=j+1
  194.     NEXT x
  195.   
  196. analyse2:
  197.     COLOR 5
  198.     LOCATE i+3,10:PRINT "Extrema"
  199.     COLOR 2
  200.     LOCATE i+5,10:PRINT "Maximum an x=";USING "#######.####";xl
  201.     LOCATE i+5,50:PRINT ", f(x)=";USING "#######.####";ymax
  202.     LOCATE i+6,10:PRINT "Minimum an x=";USING "#######.####";xr
  203.     LOCATE i+6,50:PRINT ", f(x)=";USING "#######.####";ymin
  204.   
  205.     WHILE INKEY$="":WEND
  206.     WINDOW CLOSE 3
  207.     RETURN
  208.  
  209.  
  210. graph:
  211.     IF interflag=0 THEN RETURN
  212.     WINDOW 3,,(0,0)-(631,242),0,2
  213.   
  214.     dx3=(ABS(xu)+ABS(xo))/10
  215.     dy3=(ABS(ymin)+ABS(ymax))/10
  216.  
  217.     COLOR 2
  218.     LOCATE 8,20:PRINT "Der Graph wird im Intervall [";
  219.     PRINT USING "#######.####";xu;
  220.     PRINT ";";
  221.     PRINT USING "#######.####";xo;
  222.     PRINT "]"
  223.     LOCATE 10,20:PRINT "gezeichnet."
  224.     LOCATE 12,20:PRINT "Der Abstand zwischen den Hilfspunkten beträgt"
  225.     LOCATE 14,20:PRINT "in  X-Richtung : ";
  226.     PRINT USING "####.####";dx3
  227.     LOCATE 16,20:PRINT "    Y-Richtung : ";
  228.     PRINT USING "####.####";dy3
  229.     COLOR 4
  230.     LOCATE 19,20:PRINT "Wollen Sie die Abstände ändern ? (j/n) :";
  231.  
  232.   lbl4:
  233.     a$=""
  234.     WHILE a$<>"j" AND a$<>"n"
  235.       a$=INKEY$
  236.     WEND
  237.     IF a$="n" THEN GOTO lbl5
  238.   
  239.     REM Abstaende aendern
  240.     REM -----------------
  241.     CLS
  242.   lbl6:
  243.     COLOR 3
  244.     LOCATE 9,20:PRINT "Abstand in X-Richtung : ";
  245.     PRINT USING "####.####";dx3
  246.     LOCATE 11,20:PRINT "          Y-Richtung : ";
  247.     PRINT USING "####.####";dy3
  248.     COLOR 4
  249.     LOCATE 15,20:PRINT "Abstand in X-Richtung  :              "
  250.     LOCATE 15,46
  251.     COLOR 2
  252.     CALL eingabe(ein$)
  253.     dx3=VAL(ein$)
  254.     IF dx3<=0 THEN GOTO lbl6
  255.  
  256.   lbl7:  
  257.     COLOR 4  
  258.     LOCATE 17,20:PRINT "Abstand in Y-Richtung  :              "
  259.     LOCATE 17,46
  260.     COLOR 2
  261.     CALL eingabe(ein$)
  262.     dy3=VAL(ein$)
  263.     IF dy3<=0 THEN GOTO lbl7
  264.   
  265.   lbl5:
  266.     REM Graph zeichnen
  267.     REM --------------  
  268.     CLS
  269.   
  270.     LINE (0,242-yv)-(631,242-yv),6
  271.     LINE (xv,0)-(xv,242),6
  272.     LINE (xv,0)-STEP(5,5),6
  273.     LINE (xv,0)-STEP(-5,5),6
  274.     LINE (631,242-yv)-STEP(-5,3),6
  275.     LINE (631,242-yv)-STEP(-5,-3),6
  276.   
  277.     i=0
  278.     WHILE fktzl%(i)<>0
  279.       i=i+1
  280.     WEND
  281.     PSET (xv+fkt(i,0)*dx,242-(yv+fkt(i,1)*dy)),5
  282.     i=0
  283.     FOR x=xu TO xo STEP dx2
  284.       xk=xv + fkt(i,0)*dx
  285.       yk=242-(yv + fkt(i,1)*dy)
  286.       IF fktzl%(i)=0 THEN LINE -(xk,yk),5 
  287.       i=i+1
  288.     NEXT x
  289.   
  290.     FOR x=0 TO xo STEP dx3
  291.       FOR y=0 TO ymax STEP dy3
  292.         PSET (xv+x*dx,242-yv-y*dy),7
  293.       NEXT y
  294.     NEXT x
  295.     FOR x=0 TO xo STEP dx3
  296.       FOR y=0 TO ymin STEP -dy3
  297.         PSET (xv+x*dx,242-yv-y*dy),7
  298.       NEXT y
  299.     NEXT x
  300.     FOR x=0 TO xu STEP -dx3
  301.       FOR y=0 TO ymin STEP -dy3
  302.         PSET (xv+x*dx,242-yv-y*dy),7
  303.       NEXT y
  304.     NEXT x
  305.     FOR x=0 TO xu STEP -dx3
  306.       FOR y=0 TO ymax STEP dy3
  307.         PSET (xv+x*dx,242-yv-y*dy),7
  308.       NEXT y
  309.     NEXT x
  310.  
  311.     WHILE INKEY$="":WEND
  312.     WINDOW CLOSE 3
  313.     RETURN
  314.  
  315. Fehler:
  316.   REM Fehlerbehandlung
  317.   REM ----------------
  318.   a=ERR
  319.   IF a=11 OR a=6 OR a=5THEN 
  320.       errorflag=1
  321.       RESUME NEXT
  322.     ELSE
  323.       REM falls Programmfehler
  324.       WINDOW CLOSE 2
  325.       WINDOW CLOSE 3
  326.       SCREEN CLOSE 2
  327.       ON ERROR GOTO 0
  328.       CLEAR
  329.       END
  330.   END IF  
  331.